home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vqstrg / vqdemo.frm < prev    next >
Text File  |  1995-12-05  |  16KB  |  622 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "VqString Demonstration"
  4.    ClientHeight    =   4140
  5.    ClientLeft      =   1050
  6.    ClientTop       =   2280
  7.    ClientWidth     =   7860
  8.    ControlBox      =   0   'False
  9.    Height          =   4830
  10.    Left            =   990
  11.    LinkMode        =   1  'Source
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   4140
  16.    ScaleWidth      =   7860
  17.    Top             =   1650
  18.    Width           =   7980
  19.    Begin PictureBox Picture1 
  20.       AutoSize        =   -1  'True
  21.       BorderStyle     =   0  'None
  22.       Height          =   1575
  23.       Left            =   5040
  24.       Picture         =   VQDEMO.FRX:0000
  25.       ScaleHeight     =   1575
  26.       ScaleWidth      =   2535
  27.       TabIndex        =   8
  28.       Top             =   1200
  29.       Width           =   2535
  30.    End
  31.    Begin Frame Frame1 
  32.       Caption         =   "VqString Viewer/Editor"
  33.       Height          =   2715
  34.       Left            =   360
  35.       TabIndex        =   7
  36.       Top             =   660
  37.       Width           =   4395
  38.       Begin HScrollBar HScroll1 
  39.          Enabled         =   0   'False
  40.          Height          =   375
  41.          LargeChange     =   100
  42.          Left            =   240
  43.          Max             =   8192
  44.          Min             =   1
  45.          TabIndex        =   6
  46.          Top             =   1980
  47.          Value           =   1
  48.          Width           =   3795
  49.       End
  50.       Begin TextBox Text2 
  51.          Enabled         =   0   'False
  52.          Height          =   315
  53.          Left            =   3240
  54.          TabIndex        =   3
  55.          Top             =   840
  56.          Width           =   795
  57.       End
  58.       Begin TextBox Text1 
  59.          Enabled         =   0   'False
  60.          Height          =   315
  61.          Left            =   300
  62.          ScrollBars      =   2  'Vertical
  63.          TabIndex        =   1
  64.          Top             =   840
  65.          Width           =   2715
  66.       End
  67.       Begin Label Label1 
  68.          Caption         =   "S&croll"
  69.          Height          =   255
  70.          Left            =   240
  71.          TabIndex        =   5
  72.          Top             =   1680
  73.          Width           =   675
  74.       End
  75.       Begin Label Label5 
  76.          Height          =   315
  77.          Left            =   300
  78.          TabIndex        =   4
  79.          Top             =   1200
  80.          Width           =   3735
  81.       End
  82.       Begin Label Label3 
  83.          Caption         =   "&Select"
  84.          Height          =   255
  85.          Left            =   3240
  86.          TabIndex        =   2
  87.          Top             =   540
  88.          Width           =   615
  89.       End
  90.       Begin Label Label2 
  91.          Caption         =   "&Edit"
  92.          Height          =   255
  93.          Left            =   300
  94.          TabIndex        =   0
  95.          Top             =   540
  96.          Width           =   555
  97.       End
  98.    End
  99.    Begin Menu Demo 
  100.       Caption         =   "&Demonstration"
  101.       Begin Menu VarLenStr 
  102.          Caption         =   "&Variable Length Strings"
  103.          Shortcut        =   ^V
  104.       End
  105.       Begin Menu FixLenStr 
  106.          Caption         =   "&Fixed Length Strings"
  107.          Shortcut        =   ^F
  108.       End
  109.       Begin Menu Separator1 
  110.          Caption         =   "-"
  111.       End
  112.       Begin Menu ExitProgram 
  113.          Caption         =   "E&xit"
  114.          Shortcut        =   ^X
  115.       End
  116.    End
  117.    Begin Menu Help 
  118.       Caption         =   "&Help"
  119.       Begin Menu Contents 
  120.          Caption         =   "&Contents"
  121.          Shortcut        =   {F1}
  122.       End
  123.       Begin Menu Search 
  124.          Caption         =   "&Search"
  125.       End
  126.       Begin Menu Separator2 
  127.          Caption         =   "-"
  128.       End
  129.       Begin Menu About 
  130.          Caption         =   "&About"
  131.       End
  132.    End
  133. End
  134.  
  135. Sub About_Click ()
  136.   
  137. Dim WinFlags As Long
  138. Dim Mode As String, Processor As String
  139.   
  140. '------  Get current Windows configuration
  141.   
  142. WinFlags = GetWinFlags()
  143.   
  144. CRLF$ = Chr$(13) + Chr$(10)
  145. If WinFlags And WF_ENHANCED Then Mode = "386 Enhanced" Else Mode = "Standard"
  146.   
  147. Temp$ = "VqString Demonstration " + CRLF$
  148. Temp$ = Temp$ + "Vi Qual Software" + CRLF$
  149. Temp$ = Temp$ + "Version 1.0" + CRLF$ + CRLF$
  150. Temp$ = Temp$ + "by Robert B. Heberger" + CRLF$ + CRLF$
  151. Temp$ = Temp$ + "Mode: " + Mode + CRLF$
  152. Temp$ = Temp$ + "Free Memory: " + Format$(GetFreeSpace(0) \ 1024) + " KB"
  153.   
  154. MsgBox Temp$, 64, "VqStrings"
  155.   
  156. End Sub
  157.  
  158. Sub Contents_Click ()
  159.   
  160. numData& = 1
  161. TempNum% = WinHelp(hWnd, "vqstring.hlp", HELP_CONTEXT, ByVal numData&)
  162.   
  163. End Sub
  164.  
  165. Sub ExitProgram_Click ()
  166.   
  167. '------ Erase VqString arrays
  168.  
  169. x& = VqFixLenStr(Test, 1, 0, VqEraseString)
  170. x& = VqVarLenStr(Test, 1, 0, VqEraseString)
  171. End
  172.   
  173. End Sub
  174.  
  175. Sub FixLenStr_Click ()
  176.   
  177. On Error GoTo FixedDemoError
  178.   
  179. CR$ = Chr$(13) + Chr$(10)
  180.   
  181. Msg$ = "A huge array of 8,192 fixed length strings will be built," + CR$
  182. Msg$ = Msg$ + "for a total of 131,072 bytes, or 128K of string space." + CR$ + CR$
  183. Msg$ = Msg$ + "The string length is limited to 16 characters." + CR$ + CR$
  184. Msg$ = Msg$ + "They will be stored in a VqString Array." + CR$ + CR$
  185. Msg$ = Msg$ + "Most of the time will be used by Visual Basic to build" + CR$
  186. Msg$ = Msg$ + "the strings."
  187. Response% = MsgBox(Msg$, 65, "Fixed Length Strings")
  188. Form1.Refresh
  189. If Response% = IDCANCEL Then Exit Sub
  190.   
  191. Text1.Text = ""
  192. Label5.Caption = ""
  193. Text2.Text = ""
  194. Text1.Refresh
  195.   
  196. Mode = 0
  197. HScroll1.Value = 1
  198. Mode = FixedMode
  199.   
  200. Elements = 8192
  201. StrSize = 16
  202.  
  203. '------ Initialize fixed length VqString array
  204.  
  205. x& = VqFixLenStr(Test, 1, Elements, StrSize)
  206. If x& < 0 Then
  207.     Beep
  208.     MsgBox "Can't allocate buffer", 64, "Error"
  209.     Exit Sub
  210. End If
  211.   
  212. '------ Fill fixed length VqString array
  213.  
  214. MousePointer = HourGlass
  215. For i& = 1 To 8192
  216.     Temp$ = Space$(5)
  217.     LSet Temp$ = Str$(i&)
  218.     Test = "Test String" + Temp$
  219.     If VqFixLenStr(Test, 1, i&, VqPutString) < 0 Then Error Abs(VqError)
  220. Next
  221. MousePointer = Default
  222.   
  223. Text1.Enabled = True
  224. Text2.Enabled = True
  225. HScroll1.Enabled = True
  226.  
  227. Frame1.Caption = "Fixed Length Strings"
  228. Test = Space$(16)
  229. If VqFixLenStr(Test, 1, 1, VqGetString) < 0 Then Error Abs(VqError)
  230. Text1.Text = Test
  231. SaveText1Text = Text1.Text
  232. SaveHScroll1Value = HScroll1.Value
  233. Label5.Caption = Space$(Len(Text1.Text)) + "|"
  234. Text2.Text = LTrim$(Str$(1))
  235.   
  236. Exit Sub
  237.   
  238. FixedDemoError:
  239. MsgBox Error$, 0, "Error"
  240. End
  241.   
  242. End Sub
  243.  
  244. Sub Form_Load ()
  245.   
  246. Text1.FontName = "Terminal"
  247. Text1.FontBold = False
  248. Text2.FontName = "Terminal"
  249. Text2.FontBold = False
  250. Label5.FontName = "Terminal"
  251. Label5.FontBold = False
  252.   
  253. LastControl = TextOne
  254. SaveHScroll1Value = HScroll1.Value
  255.   
  256. End Sub
  257.  
  258. Sub HelpIndex_Click ()
  259.   
  260. numData& = 1
  261. TempNum% = WinHelp(hWnd, "c:\vb\hugestr\vqstring.hlp", HELP_CONTEXT, ByVal numData&)
  262.   
  263. End Sub
  264.  
  265. Sub HScroll1_Change ()
  266.   
  267. On Error GoTo HScroll1ChangeError
  268.   
  269. CR$ = Chr$(13) + Chr$(10)
  270.  
  271. ScrollEvent = True
  272.   
  273. Index& = HScroll1.Value
  274. Select Case Mode
  275.     Case VariableMode
  276.         Temp$ = SaveText1Text
  277.         If VqPutVarString(Temp$, 1, CLng(SaveHScroll1Value)) < 0 Then Error Abs(VqError)
  278.         If VqGetVarString(Test, 1, Index&) < 0 Then Error Abs(VqError)
  279.     Case FixedMode
  280.         Temp$ = Space$(16)
  281.         LSet Temp$ = SaveText1Text
  282.         If VqFixLenStr(Temp$, 1, CLng(SaveHScroll1Value), VqPutString) < 0 Then Error Abs(VqError)
  283.         If VqFixLenStr(Test, 1, Index&, VqGetString) < 0 Then Error Abs(VqError)
  284. End Select
  285.   
  286. Text1.Text = Test
  287. If Mode = FixedMode Then Label5.Caption = Space$(Len(Text1.Text)) + "|"
  288. Text2.Text = LTrim$(Str$(Index&))
  289.   
  290. Exit Sub
  291.   
  292. HScroll1ChangeError:
  293. If Mode = VariableMode And VqError = OutOfStringSpace Then
  294.     Beep
  295.     Msg$ = "Out of string space." + CR$
  296.     Msg$ = Msg$ + "There is a limit of 131,072" + CR$
  297.     Msg$ = Msg$ + "bytes in this array."
  298.     MsgBox Msg$, 64, "Out of String Space"
  299.     Test = "Test String" + Str$(SaveHScroll1Value)
  300.     Text1.Text = Test
  301.     SaveText1Text = Test
  302.